home *** CD-ROM | disk | FTP | other *** search
/ Chip 2007 January, February, March & April / Chip-Cover-CD-2007-02.iso / Pakiet bezpieczenstwa / mini Pentoo LiveCD 2006.1 / mpentoo-2006.1.iso / livecd.squashfs / usr / lib / perl5 / 5.8.7 / ExtUtils / Constant / Utils.pm < prev    next >
Encoding:
Perl POD Document  |  2006-04-25  |  3.1 KB  |  124 lines
  1. package ExtUtils::Constant::Utils;
  2.  
  3. use strict;
  4. use vars qw($VERSION @EXPORT_OK @ISA $is_perl56);
  5. use Carp;
  6.  
  7. @ISA = 'Exporter';
  8. @EXPORT_OK = qw(C_stringify perl_stringify);
  9. $VERSION = '0.01';
  10.  
  11. $is_perl56 = ($] < 5.007 && $] > 5.005_50);
  12.  
  13. =head1 NAME
  14.  
  15. ExtUtils::Constant::Utils - helper functions for ExtUtils::Constant
  16.  
  17. =head1 SYNOPSIS
  18.  
  19.     use ExtUtils::Constant::Utils qw (C_stringify);
  20.     $C_code = C_stringify $stuff;
  21.  
  22. =head1 DESCRIPTION
  23.  
  24. ExtUtils::Constant::Utils packages up utility subroutines used by
  25. ExtUtils::Constant, ExtUtils::Constant::Base and derived classes. All its
  26. functions are explicitly exportable.
  27.  
  28. =head1 USAGE
  29.  
  30. =over 4
  31.  
  32. =item C_stringify NAME
  33.  
  34. A function which returns a 7 bit ASCII correctly \ escaped version of the
  35. string passed suitable for C's "" or ''. It will die if passed Unicode
  36. characters.
  37.  
  38. =cut
  39.  
  40. # Hopefully make a happy C identifier.
  41. sub C_stringify {
  42.   local $_ = shift;
  43.   return unless defined $_;
  44.   # grr 5.6.1
  45.   confess "Wide character in '$_' intended as a C identifier"
  46.     if tr/\0-\377// != length;
  47.   # grr 5.6.1 moreso because its regexps will break on data that happens to
  48.   # be utf8, which includes my 8 bit test cases.
  49.   $_ = pack 'C*', unpack 'U*', $_ . pack 'U*' if $is_perl56;
  50.   s/\\/\\\\/g;
  51.   s/([\"\'])/\\$1/g;    # Grr. fix perl mode.
  52.   s/\n/\\n/g;        # Ensure newlines don't end up in octal
  53.   s/\r/\\r/g;
  54.   s/\t/\\t/g;
  55.   s/\f/\\f/g;
  56.   s/\a/\\a/g;
  57.   s/([^\0-\177])/sprintf "\\%03o", ord $1/ge;
  58.   unless ($] < 5.006) {
  59.     # This will elicit a warning on 5.005_03 about [: :] being reserved unless
  60.     # I cheat
  61.     my $cheat = '([[:^print:]])';
  62.     s/$cheat/sprintf "\\%03o", ord $1/ge;
  63.   } else {
  64.     require POSIX;
  65.     s/([^A-Za-z0-9_])/POSIX::isprint($1) ? $1 : sprintf "\\%03o", ord $1/ge;
  66.   }
  67.   $_;
  68. }
  69.  
  70. =item perl_stringify NAME
  71.  
  72. A function which returns a 7 bit ASCII correctly \ escaped version of the
  73. string passed suitable for a perl "" string.
  74.  
  75. =cut
  76.  
  77. # Hopefully make a happy perl identifier.
  78. sub perl_stringify {
  79.   local $_ = shift;
  80.   return unless defined $_;
  81.   s/\\/\\\\/g;
  82.   s/([\"\'])/\\$1/g;    # Grr. fix perl mode.
  83.   s/\n/\\n/g;        # Ensure newlines don't end up in octal
  84.   s/\r/\\r/g;
  85.   s/\t/\\t/g;
  86.   s/\f/\\f/g;
  87.   s/\a/\\a/g;
  88.   unless ($] < 5.006) {
  89.     if ($] > 5.007) {
  90.       s/([^\0-\177])/sprintf "\\x{%X}", ord $1/ge;
  91.     } else {
  92.       # Grr 5.6.1. And I don't think I can use utf8; to force the regexp
  93.       # because 5.005_03 will fail.
  94.       # This is grim, but I also can't split on //
  95.       my $copy;
  96.       foreach my $index (0 .. length ($_) - 1) {
  97.         my $char = substr ($_, $index, 1);
  98.         $copy .= ($char le "\177") ? $char : sprintf "\\x{%X}", ord $char;
  99.       }
  100.       $_ = $copy;
  101.     }
  102.     # This will elicit a warning on 5.005_03 about [: :] being reserved unless
  103.     # I cheat
  104.     my $cheat = '([[:^print:]])';
  105.     s/$cheat/sprintf "\\%03o", ord $1/ge;
  106.   } else {
  107.     # Turns out "\x{}" notation only arrived with 5.6
  108.     s/([^\0-\177])/sprintf "\\x%02X", ord $1/ge;
  109.     require POSIX;
  110.     s/([^A-Za-z0-9_])/POSIX::isprint($1) ? $1 : sprintf "\\%03o", ord $1/ge;
  111.   }
  112.   $_;
  113. }
  114.  
  115. 1;
  116. __END__
  117.  
  118. =back
  119.  
  120. =head1 AUTHOR
  121.  
  122. Nicholas Clark <nick@ccl4.org> based on the code in C<h2xs> by Larry Wall and
  123. others
  124.